home *** CD-ROM | disk | FTP | other *** search
/ EuroCD 3 / EuroCD 3.iso / Programming / PPCbwb111 / source / bwb_dio.c < prev    next >
C/C++ Source or Header  |  1998-06-24  |  45KB  |  1,937 lines
  1. /***************************************************************
  2.  
  3.         bwb_dio.c       Device Input/Output Routines
  4.                         for Bywater BASIC Interpreter
  5.  
  6.                         Copyright (c) 1992, Ted A. Campbell
  7.  
  8.                         Bywater Software
  9.                         P. O. Box 4023
  10.                         Duke Station
  11.                         Durham, NC  27706
  12.  
  13.                         email: tcamp@acpub.duke.edu
  14.  
  15.         Copyright and Permissions Information:
  16.  
  17.         All U.S. and international copyrights are claimed by the
  18.         author. The author grants permission to use this code
  19.         and software based on it under the following conditions:
  20.         (a) in general, the code and software based upon it may be
  21.         used by individuals and by non-profit organizations; (b) it
  22.         may also be utilized by governmental agencies in any country,
  23.         with the exception of military agencies; (c) the code and/or
  24.         software based upon it may not be sold for a profit without
  25.         an explicit and specific permission from the author, except
  26.         that a minimal fee may be charged for media on which it is
  27.         copied, and for copying and handling; (d) the code must be
  28.         distributed in the form in which it has been released by the
  29.         author; and (e) the code and software based upon it may not
  30.         be used for illegal activities.
  31.  
  32. ***************************************************************/
  33.  
  34. #include <stdio.h>
  35. #include <stdlib.h>
  36. #include <string.h>
  37.  
  38. #include "bwbasic.h"
  39. #include "bwb_mes.h"
  40.  
  41. #if UNIX_CMDS
  42. #include <sys/types.h>
  43. #include <sys/stat.h>
  44. #endif
  45.  
  46. #ifndef SEEK_SET            /* added in v1.11 */
  47. #include <unistd.h>
  48. #endif
  49.  
  50. #if INTENSIVE_DEBUG
  51. #define RANDOM_FILLCHAR        'X'
  52. #else
  53. #define RANDOM_FILLCHAR        ' '
  54. #endif
  55.  
  56. struct dev_element *dev_table;          /* table of devices */
  57.  
  58. static struct bwb_variable *v;
  59. static int pos;
  60. static int req_devnumber;
  61. static int rlen;
  62. static int mode;
  63.  
  64. static struct bwb_line *dio_lrset( struct bwb_line *l, int rset );
  65. static int dio_flush( int dev_number );
  66.  
  67. /***************************************************************
  68.  
  69.         FUNCTION:       bwb_open()
  70.  
  71.         DESCRIPTION: This function implements the BASIC OPEN
  72.         command to open a stream for device input/output.
  73.  
  74.         SYNTAX: 1. OPEN "I"|"O"|"R", [#]n, filename [,rlen]
  75.                 2. OPEN filename [FOR INPUT|OUTPUT|APPEND|] AS [#]n [LEN=n]
  76.  
  77. ***************************************************************/
  78.  
  79. struct bwb_line *
  80. bwb_open( struct bwb_line *l )
  81.    {
  82.    FILE *fp;
  83.    struct exp_ese *e;
  84.    register int n;
  85.    int previous_buffer;
  86.    char atbuf[ MAXSTRINGSIZE + 1 ];
  87.    char first[ MAXSTRINGSIZE + 1 ];
  88.    char devname[ MAXSTRINGSIZE + 1 ];
  89.  
  90.    /* initialize */
  91.  
  92.    mode = req_devnumber = rlen = -1;
  93.    previous_buffer = FALSE;
  94.  
  95.    /* get the first expression element up to comma or whitespace */
  96.  
  97.    adv_element( l->buffer, &( l->position ), atbuf );
  98.  
  99.    /* parse the first expression element */
  100.  
  101.    pos = 0;
  102.    e = bwb_exp( atbuf, FALSE, &pos );
  103.    str_btoc( first, exp_getsval( e ) );
  104.  
  105. #if INTENSIVE_DEBUG
  106.    sprintf( bwb_ebuf, "in bwb_open(): first element is <%s>",
  107.       first );
  108.    bwb_debug( bwb_ebuf );
  109. #endif
  110.  
  111.    /* test for syntactical form: if a comma follows the first element, 
  112.       then the syntax is form 1 (the old CP/M BASIC format); otherwise we
  113.       presume form 2 */
  114.  
  115.    adv_ws( l->buffer, &( l->position ) );
  116.  
  117.    /* Parse syntax Form 1 (OPEN "x", #n, devname...) */
  118.  
  119.    if ( l->buffer[ l->position ] == ',' )
  120.       {
  121.  
  122.       /* parse the next element to get the device number */
  123.  
  124.       ++( l->position );                        /* advance beyond comma */
  125.       adv_ws( l->buffer, &( l->position ) );
  126.       if ( l->buffer[ l->position ] == '#' )
  127.          {
  128.          ++( l->position );
  129.          adv_ws( l->buffer, &( l->position ) );
  130.          }
  131.  
  132.       adv_element( l->buffer, &( l->position ), atbuf );
  133.  
  134.       pos = 0;
  135.       e = bwb_exp( atbuf, FALSE, &pos );
  136.       if ( e->type == STRING )
  137.          {
  138. #if PROG_ERRORS
  139.      bwb_error( "String where integer was expected for device number" );
  140. #else
  141.      bwb_error( err_syntax );
  142. #endif
  143.          l->next->position = 0;
  144.          return l->next;
  145.          }
  146.       req_devnumber = exp_getival( e );
  147.  
  148. #if INTENSIVE_DEBUG
  149.       sprintf( bwb_ebuf, "in bwb_open(): syntax 1, req dev number is %d",
  150.          req_devnumber );
  151.       bwb_debug( bwb_ebuf );
  152. #endif
  153.  
  154.       /* parse the next element to get the devname */
  155.  
  156.       adv_ws( l->buffer, &( l->position ) );    /* advance past whitespace */
  157.       ++( l->position );                        /* advance past comma */
  158.       adv_element( l->buffer, &( l->position ), atbuf );
  159.  
  160.       pos = 0;
  161.       e = bwb_exp( atbuf, FALSE, &pos );
  162.       if ( e->type != STRING )
  163.          {
  164. #if PROG_ERRORS
  165.      bwb_error( "in bwb_open(): number where string was expected for devname" );
  166. #else
  167.      bwb_error( err_syntax );
  168. #endif
  169.          l->next->position = 0;
  170.          return l->next;
  171.          }
  172.       str_btoc( devname, exp_getsval( e ) );
  173.  
  174. #if INTENSIVE_DEBUG
  175.       sprintf( bwb_ebuf, "in bwb_open(): syntax 1, devname <%s>",
  176.          devname  );
  177.       bwb_debug( bwb_ebuf );
  178. #endif
  179.  
  180.       /* see if there is another element; if so, parse it to get the
  181.          record length */
  182.  
  183.       adv_ws( l->buffer, &( l->position ) );
  184.       if ( l->buffer[ l->position ] == ',' )
  185.          {
  186.  
  187.          ++( l->position );                     /* advance beyond comma */
  188.          adv_element( l->buffer, &( l->position ), atbuf );
  189.  
  190.          pos = 0;
  191.          e = bwb_exp( atbuf, FALSE, &pos );
  192.          if ( e->type == STRING )
  193.             {
  194. #if PROG_ERRORS
  195.             bwb_error( "String where integer was expected for record length" );
  196. #else
  197.             bwb_error( err_syntax );
  198. #endif
  199.             l->next->position = 0;
  200.             return l->next;
  201.             }
  202.          rlen = exp_getival( e );
  203.  
  204. #if INTENSIVE_DEBUG
  205.          sprintf( bwb_ebuf, "in bwb_open(): syntax 1, record length is %d",
  206.             rlen );
  207.          bwb_debug( bwb_ebuf );
  208. #endif
  209.  
  210.          }
  211.  
  212.       /* the first letter of the first should indicate the
  213.          type of file opening requested: test this letter,
  214.          then parse accordingly */
  215.  
  216.       /* open file for sequential INPUT */
  217.  
  218.       if ( ( first[ 0 ] == 'i' ) || ( first[ 0 ] == 'I' ))
  219.          {
  220.          mode = DEVMODE_INPUT;
  221.          }
  222.  
  223.       /* open file for sequential OUTPUT */
  224.  
  225.       else if ( ( first[ 0 ] == 'o' ) || ( first[ 0 ] == 'O' ))
  226.          {
  227.          mode = DEVMODE_OUTPUT;
  228.          }
  229.  
  230.       /* open file for RANDOM access input and output */
  231.  
  232.       else if ( ( first[ 0 ] == 'r' ) || ( first[ 0 ] == 'R' ))
  233.          {
  234.          mode = DEVMODE_RANDOM;
  235.          }
  236.  
  237.       /* error: none of the appropriate modes found */
  238.  
  239.       else
  240.          {
  241. #if PROG_ERRORS
  242.      sprintf( bwb_ebuf, "in bwb_open(): invalid mode" );
  243.      bwb_error( bwb_ebuf );
  244. #else
  245.      bwb_error( err_syntax );
  246. #endif
  247.          }
  248.  
  249. #if INTENSIVE_DEBUG
  250.       sprintf( bwb_ebuf, "in bwb_open(): syntax 1, mode is %d", mode );
  251.       bwb_debug( bwb_ebuf );
  252. #endif
  253.  
  254.       }
  255.  
  256.    /* Parse syntax Form 2 (OPEN devname FOR mode AS #n ... ) */
  257.  
  258.    else
  259.       {
  260.  
  261.       /* save the devname from first */
  262.  
  263.       strcpy( devname, first );
  264.  
  265. #if INTENSIVE_DEBUG
  266.       sprintf( bwb_ebuf, "in bwb_open(): syntax 2, devname <%s>",
  267.          devname );
  268.       bwb_debug( bwb_ebuf );
  269. #endif
  270.  
  271.       /* get the next element */
  272.  
  273.       adv_element( l->buffer, &( l->position ), atbuf );
  274.  
  275.       /* check for "FOR mode" statement */
  276.  
  277.       bwb_strtoupper( atbuf );
  278.       if ( strcmp( atbuf, "FOR" ) == 0 )
  279.          {
  280.          adv_element( l->buffer, &( l->position ), atbuf );
  281.          bwb_strtoupper( atbuf );
  282.          if ( strcmp( atbuf, "INPUT" ) == 0 )
  283.             {
  284.             mode = DEVMODE_INPUT;
  285.             }
  286.          else if ( strcmp( atbuf, "OUTPUT" ) == 0 )
  287.             {
  288.             mode = DEVMODE_OUTPUT;
  289.             }
  290.          else if ( strcmp( atbuf, "APPEND" ) == 0 )
  291.             {
  292.             mode = DEVMODE_RANDOM;
  293.             }
  294.          else 
  295.             {
  296. #if PROG_ERRORS
  297.             bwb_error( "in bwb_open(): Invalid device i/o mode specified" );
  298. #else
  299.             bwb_error( err_syntax );
  300. #endif
  301.             l->next->position = 0;
  302.             return l->next;
  303.             }
  304.  
  305.          /* get the next element */
  306.  
  307.          adv_element( l->buffer, &( l->position ), atbuf );
  308.  
  309.          }
  310.       else
  311.          {
  312.          mode = DEVMODE_RANDOM;
  313.          }
  314.  
  315. #if INTENSIVE_DEBUG
  316.       sprintf( bwb_ebuf, "in bwb_open(): syntax 2, mode is %d", mode );
  317.       bwb_debug( bwb_ebuf );
  318. #endif
  319.  
  320.       /* This leaves us with the next element in the atbuf: it
  321.          should read "AS" */
  322.  
  323.       bwb_strtoupper( atbuf );
  324.       if ( strcmp( atbuf, "AS" ) != 0 )
  325.          {
  326. #if PROG_ERRORS
  327.          bwb_error( "in bwb_open(): expected AS statement" );
  328. #else
  329.          bwb_error( err_syntax );
  330. #endif
  331.          l->next->position = 0;
  332.          return l->next;
  333.          }
  334.  
  335.       /* get the next element */
  336.  
  337.       adv_ws( l->buffer, &( l->position ) );
  338.  
  339.       if ( l->buffer[ l->position ] == '#' )
  340.          {
  341.          ++( l->position );
  342.          }
  343.  
  344.       adv_element( l->buffer, &( l->position ), atbuf );
  345.  
  346. #if INTENSIVE_DEBUG
  347.       sprintf( bwb_ebuf, "in bwb_open(): string to parse for req dev number <%s>",
  348.          atbuf );
  349.       bwb_debug( bwb_ebuf );
  350. #endif
  351.  
  352.       pos = 0;
  353.       e = bwb_exp( atbuf, FALSE, &pos );
  354.       if ( e->type == STRING )
  355.          {
  356. #if PROG_ERRORS
  357.          bwb_error( "String where integer was expected for record length" );
  358. #else
  359.          bwb_error( err_syntax );
  360. #endif
  361.          l->next->position = 0;
  362.          return l->next;
  363.          }
  364.       req_devnumber = exp_getival( e );
  365.  
  366. #if INTENSIVE_DEBUG
  367.       sprintf( bwb_ebuf, "in bwb_open(): syntax 2, req dev number is %d",
  368.          req_devnumber );
  369.       bwb_debug( bwb_ebuf );
  370. #endif
  371.  
  372.       /* Check for LEN = n statement */
  373.  
  374.       adv_element( l->buffer, &( l->position ), atbuf );
  375.       bwb_strtoupper( atbuf );
  376.       if ( strncmp( atbuf, "LEN", (size_t) 3 ) == 0 )
  377.          {
  378.  
  379.          pos = l->position - strlen( atbuf );
  380.          while( ( l->buffer[ pos ] != '=' ) && ( l->buffer[ pos ] != '\0' ))
  381.             {
  382.             ++pos;
  383.             }
  384.          if ( l->buffer[ pos ] == '\0' )
  385.             {
  386. #if PROG_ERRORS
  387.             bwb_error( "Failed to find equals sign after LEN element" );
  388. #else
  389.             bwb_error( err_syntax );
  390. #endif
  391.             l->next->position = 0;
  392.             return l->next;
  393.             }
  394.          ++pos;         /* advance past equal sign */
  395.  
  396.          e = bwb_exp( l->buffer, FALSE, &pos );
  397.  
  398.          if ( e->type == STRING )
  399.             {
  400. #if PROG_ERRORS
  401.             bwb_error( "String where integer was expected for record length" );
  402. #else
  403.             bwb_error( err_syntax );
  404. #endif
  405.             l->next->position = 0;
  406.             return l->next;
  407.             }
  408.          rlen = exp_getival( e );
  409.  
  410. #if INTENSIVE_DEBUG
  411.          sprintf( bwb_ebuf, "in bwb_open(): syntax 2, record length is %d",
  412.             rlen );
  413.          bwb_debug( bwb_ebuf );
  414. #endif
  415.  
  416.          }
  417.  
  418.       }                                 /* end of syntax 2 */
  419.  
  420.    /* check for valid requested device number */
  421.  
  422.    if ( ( req_devnumber < 0 ) || ( req_devnumber >= DEF_DEVICES ))
  423.       {
  424. #if PROG_ERRORS
  425.       bwb_error( "in bwb_open(): Requested device number is out of range." );
  426. #else
  427.       bwb_error( err_devnum );
  428. #endif
  429.       l->next->position = 0;
  430.       return l->next;
  431.       }
  432.  
  433.    if ( dev_table[ req_devnumber ].mode == DEVMODE_CLOSED )
  434.       {
  435. #if INTENSIVE_DEBUG
  436.       sprintf( bwb_ebuf, "in bwb_open(): using previously closed file (and buffer)" );
  437.       bwb_debug( bwb_ebuf );
  438. #endif
  439.       previous_buffer = TRUE;
  440.       }
  441.  
  442.    if ( ( dev_table[ req_devnumber ].mode != DEVMODE_CLOSED ) &&
  443.       ( dev_table[ req_devnumber ].mode != DEVMODE_AVAILABLE ) )
  444.       {
  445. #if PROG_ERRORS
  446.       bwb_error( "in bwb_open(): Requested device number is already in use." );
  447. #else
  448.       bwb_error( err_devnum );
  449. #endif
  450.  
  451.       l->next->position = 0;
  452.       return l->next;
  453.       }
  454.  
  455. #if INTENSIVE_DEBUG
  456.    sprintf( bwb_ebuf, "in bwb_open(): ready to open device <%s> mode <%d>",
  457.       devname, mode );
  458.    bwb_debug( bwb_ebuf );
  459. #endif
  460.  
  461.    /* attempt to open the file */
  462.  
  463.    switch( mode )
  464.       {
  465.       case DEVMODE_OUTPUT:
  466.          fp = fopen( devname, "w" );
  467.          break;
  468.       case DEVMODE_INPUT:
  469.          fp = fopen( devname, "r" );
  470.          break;
  471.       case DEVMODE_APPEND:
  472.          fp = fopen( devname, "a" );
  473.          break;
  474.       case DEVMODE_RANDOM:
  475.          fp = fopen( devname, "r+" );
  476.          if ( fp == NULL )
  477.             {
  478.             fp = fopen( devname, "w" );
  479.             fclose( fp );
  480.             fp = fopen( devname, "r+" );
  481.             }
  482.          break;
  483.       }
  484.  
  485.    /* check for valid file opening */
  486.  
  487.    if ( fp == NULL )
  488.       {
  489. #if PROG_ERRORS
  490.       sprintf( bwb_ebuf, "Failed to open device <%s>", devname );
  491.       bwb_error( bwb_ebuf );
  492. #else
  493.       bwb_error( err_dev );
  494. #endif
  495.       l->next->position = 0;
  496.       return l->next;
  497.       }
  498.  
  499.    /* assign values to device table */
  500.  
  501.    dev_table[ req_devnumber ].mode = mode;
  502.    dev_table[ req_devnumber ].cfp = fp;
  503.    dev_table[ req_devnumber ].reclen = rlen;
  504.    dev_table[ req_devnumber ].next_record = 1;
  505.    dev_table[ req_devnumber ].loc = 0;
  506.    strcpy( dev_table[ req_devnumber ].filename, devname );
  507.  
  508.    /* allocate a character buffer for random access */
  509.  
  510.    if (( mode == DEVMODE_RANDOM ) && ( previous_buffer != TRUE ))
  511.       {
  512.       if ( ( dev_table[ req_devnumber ].buffer = calloc( rlen + 1, 1 )) == NULL )
  513.          {
  514.          bwb_error( err_getmem );
  515.          return l;
  516.          }
  517.  
  518.       dio_flush( req_devnumber );
  519.  
  520. #if INTENSIVE_DEBUG
  521.       sprintf( bwb_ebuf, "in bwb_open(): allocated new random-access buffer" );
  522.       bwb_debug( bwb_ebuf );
  523. #endif
  524.  
  525.       }
  526.  
  527. #if INTENSIVE_DEBUG
  528.    sprintf( bwb_ebuf, "in bwb_open(): file is open now; end of function" );
  529.    bwb_debug( bwb_ebuf );
  530. #endif
  531.  
  532.    /* return next line number in sequence */
  533.  
  534.    l->next->position = 0;
  535.    return l->next;
  536.    }
  537.  
  538. /***************************************************************
  539.  
  540.         FUNCTION:       bwb_close()
  541.  
  542.         DESCRIPTION: This function implements the BASIC CLOSE
  543.         command to close a stream for device input/output.
  544.   
  545.         SYNTAX:         CLOSE [#]n [,[#]n...]
  546.  
  547. ***************************************************************/
  548.  
  549. struct bwb_line *
  550. bwb_close( struct bwb_line *l )
  551.    {
  552.    struct exp_ese *e;
  553.    char atbuf[ MAXSTRINGSIZE + 1 ];
  554.  
  555.    /* loop to get device numbers to close */
  556.  
  557.    do
  558.       {
  559.  
  560.       adv_ws( l->buffer, &( l->position ) );
  561.       if ( l->buffer[ l->position ] =='#' )
  562.          {
  563.          ++( l->position );
  564.          }
  565.  
  566.       adv_element( l->buffer, &( l->position ), atbuf );
  567.  
  568.       pos = 0;
  569.       e = bwb_exp( atbuf, FALSE, &pos );
  570.  
  571.       if ( e->type == STRING )
  572.          {
  573. #if PROG_ERRORS
  574.          bwb_error( "String where integer was expected for device number" );
  575. #else
  576.          bwb_error( err_syntax );
  577. #endif
  578.          l->next->position = 0;
  579.          return l->next;
  580.          }
  581.  
  582.       req_devnumber = exp_getival( e );
  583.  
  584. #if INTENSIVE_DEBUG
  585.       sprintf( bwb_ebuf, "in bwb_close(): requested device number <%d>",
  586.          req_devnumber );
  587.       bwb_debug( bwb_ebuf );
  588. #endif
  589.  
  590.       /* check for valid requested device number */
  591.  
  592.       if ( ( req_devnumber < 0 ) || ( req_devnumber >= DEF_DEVICES ))
  593.          {
  594. #if PROG_ERRORS
  595.          bwb_error( "in bwb_close(): Requested device number is out if range." );
  596. #else
  597.          bwb_error( err_devnum );
  598. #endif
  599.          l->next->position = 0;
  600.          return l->next;
  601.          }
  602.  
  603.       if (( dev_table[ req_devnumber ].mode == DEVMODE_CLOSED ) ||
  604.          ( dev_table[ req_devnumber ].mode == DEVMODE_AVAILABLE ) )
  605.          {
  606. #if PROG_ERRORS
  607.          bwb_error( "in bwb_close(): Requested device number is not in use." );
  608. #else
  609.          bwb_error( err_devnum );
  610. #endif
  611.  
  612.          l->next->position = 0;
  613.          return l->next;
  614.          }
  615.  
  616. #if INTENSIVE_DEBUG
  617.       sprintf( bwb_ebuf, "in bwb_close(): closing device # <%d>",
  618.      req_devnumber );
  619.       bwb_debug( bwb_ebuf );
  620. #endif
  621.  
  622.       /* attempt to close the file */
  623.  
  624.       if ( fclose( dev_table[ req_devnumber ].cfp ) != 0 )
  625.          {
  626. #if PROG_ERRORS
  627.          bwb_error( "in bwb_close(): Failed to close the device" );
  628. #else
  629.          bwb_error( err_dev );
  630. #endif
  631.          l->next->position = 0;
  632.          return l->next;
  633.          }
  634.  
  635.       /* mark the device in the table as unavailable */
  636.  
  637.       dev_table[ req_devnumber ].mode = DEVMODE_CLOSED;
  638.  
  639.       /* eat up any remaining whitespace */
  640.  
  641.       adv_ws( l->buffer, &( l->position ) );
  642.  
  643.       }
  644.  
  645.    while ( l->buffer[ l->position ] == ',' );
  646.  
  647.    /* return next line number in sequence */
  648.  
  649.    l->next->position = 0;
  650.    return l->next;
  651.    }
  652.  
  653. /***************************************************************
  654.  
  655.         FUNCTION:       bwb_chdir()
  656.  
  657.         DESCRIPTION: This function implements the BASIC CHDIR
  658.         command to switch logged directories.
  659.  
  660.         SYNTAX: CHDIR pathname$
  661.  
  662. ***************************************************************/
  663.  
  664. #if UNIX_CMDS
  665. struct bwb_line *
  666. bwb_chdir( struct bwb_line *l )
  667.    {
  668.    int r;
  669.    static int position;
  670.    struct exp_ese *e;
  671.    static char *atbuf;
  672.    static int init = FALSE;
  673.  
  674.    /* get memory for temporary buffers if necessary */
  675.  
  676.    if ( init == FALSE )
  677.       {
  678.       init = TRUE;
  679.       if ( ( atbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL )
  680.          {
  681.          bwb_error( err_getmem );
  682.          }
  683.       }
  684.  
  685.    /* get the next element in atbuf */
  686.  
  687.    adv_element( l->buffer, &( l->position ), atbuf  );
  688.  
  689. #if INTENSIVE_DEBUG
  690.    sprintf( bwb_ebuf, "in bwb_chdir(): argument is <%s>", atbuf );
  691.    bwb_debug( bwb_ebuf );
  692. #endif
  693.  
  694.    /* interpret the argument */
  695.  
  696.    position = 0;
  697.    e = bwb_exp( atbuf, FALSE, &position );
  698.  
  699.    if ( e->type != STRING )
  700.       {
  701.       bwb_error( err_argstr );
  702.       l->next->position = 0;
  703.       return l->next;
  704.       }
  705.  
  706.    /* try to chdir to the requested directory */
  707.  
  708.    str_btoc( atbuf, &( e->sval ) );
  709.    r = chdir( atbuf );
  710.  
  711.    /* detect error */
  712.  
  713.    if ( r == -1 )
  714.       {
  715.       bwb_error( err_opsys );
  716.       l->next->position = 0;
  717.       return l->next;
  718.       }
  719.  
  720.    l->next->position = 0;
  721.    return l->next;
  722.  
  723.    }
  724.  
  725. /***************************************************************
  726.  
  727.         FUNCTION:       bwb_rmdir()
  728.  
  729.         DESCRIPTION: This function implements the BASIC CHDIR
  730.         command to remove a subdirectory.
  731.  
  732.         SYNTAX: RMDIR pathname$
  733.  
  734. ***************************************************************/
  735.  
  736. struct bwb_line *
  737. bwb_rmdir( struct bwb_line *l )
  738.    {
  739.    int r;
  740.    static int position;
  741.    struct exp_ese *e;
  742.    static char *atbuf;
  743.    static int init = FALSE;
  744.  
  745.    /* get memory for temporary buffers if necessary */
  746.  
  747.    if ( init == FALSE )
  748.       {
  749.       init = TRUE;
  750.       if ( ( atbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL )
  751.          {
  752.          bwb_error( err_getmem );
  753.          }
  754.       }
  755.  
  756.    /* get the next element in atbuf */
  757.  
  758.    adv_element( l->buffer, &( l->position ), atbuf  );
  759.  
  760. #if INTENSIVE_DEBUG
  761.    sprintf( bwb_ebuf, "in bwb_rmdir(): argument is <%s>", atbuf );
  762.    bwb_debug( bwb_ebuf );
  763. #endif
  764.  
  765.    /* interpret the argument */
  766.  
  767.    position = 0;
  768.    e = bwb_exp( atbuf, FALSE, &position );
  769.  
  770.    if ( e->type != STRING )
  771.       {
  772.       bwb_error( err_argstr );
  773.       l->next->position = 0;
  774.       return l->next;
  775.       }
  776.  
  777.    /* try to remove the requested directory */
  778.  
  779.    str_btoc( atbuf, &( e->sval ) );
  780.    r = rmdir( atbuf );
  781.  
  782.    /* detect error */
  783.  
  784.    if ( r == -1 )
  785.       {
  786.       bwb_error( err_opsys );
  787.       }
  788.  
  789.    l->next->position = 0;
  790.    return l->next;
  791.  
  792.    }
  793.  
  794. /***************************************************************
  795.  
  796.         FUNCTION:       bwb_mkdir()
  797.  
  798.         DESCRIPTION: This function implements the BASIC MKDIR
  799.         command to create a new subdirectory.
  800.  
  801.         SYNTAX: MKDIR pathname$
  802.  
  803. ***************************************************************/
  804.  
  805. struct bwb_line *
  806. bwb_mkdir( struct bwb_line *l )
  807.    {
  808.    int r;
  809.    static int position;
  810.    struct exp_ese *e;
  811.    static char *atbuf;
  812.    static int init = FALSE;
  813.  
  814.    /* get memory for temporary buffers if necessary */
  815.  
  816.    if ( init == FALSE )
  817.       {
  818.       init = TRUE;
  819.       if ( ( atbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL )
  820.          {
  821.          bwb_error( err_getmem );
  822.          }
  823.       }
  824.  
  825.    /* get the next element in atbuf */
  826.  
  827.    adv_element( l->buffer, &( l->position ), atbuf  );
  828.  
  829. #if INTENSIVE_DEBUG
  830.    sprintf( bwb_ebuf, "in bwb_mkdir(): argument is <%s>", atbuf );
  831.    bwb_debug( bwb_ebuf );
  832. #endif
  833.  
  834.    /* interpret the argument */
  835.  
  836.    position = 0;
  837.    e = bwb_exp( atbuf, FALSE, &position );
  838.  
  839.    if ( e->type != STRING )
  840.       {
  841.       bwb_error( err_argstr );
  842.       l->next->position = 0;
  843.       return l->next;
  844.       }
  845.  
  846.    /* try to make the requested directory */
  847.  
  848.    str_btoc( atbuf, &( e->sval ) );
  849. #if MKDIR_ONE_ARG
  850.    r = mkdir( atbuf );
  851. #else
  852.    r = mkdir( atbuf, PERMISSIONS );
  853. #endif
  854.  
  855.    /* detect error */
  856.  
  857.    if ( r == -1 )
  858.       {
  859.       bwb_error( err_opsys );
  860.       }
  861.  
  862.    l->next->position = 0;
  863.    return l->next;
  864.  
  865.    }
  866.  
  867. /***************************************************************
  868.  
  869.         FUNCTION:       fnc_lof()
  870.  
  871.         DESCRIPTION:    This C function implements the BASIC
  872.             LOF() function. 
  873.  
  874. ***************************************************************/
  875.  
  876. struct bwb_variable *
  877. fnc_lof( int argc, struct bwb_variable *argv )
  878.    {
  879.    static struct bwb_variable nvar;
  880.    static int init = FALSE;
  881.    int dev_number;
  882.    int r;
  883.    static struct stat statbuf;
  884.  
  885. #if INTENSIVE_DEBUG
  886.    sprintf( bwb_ebuf, "in fnc_lof(): received f_arg <%f> ",
  887.       var_getdval( &( argv[ 0 ] ) ) );
  888.    bwb_debug( bwb_ebuf );
  889. #endif
  890.  
  891.    if ( argc < 1 )
  892.       {
  893. #if PROG_ERRORS
  894.       sprintf( bwb_ebuf, "Not enough parameters (%d) to function LOF().",
  895.          argc );
  896.       bwb_error( bwb_ebuf );
  897. #else
  898.       bwb_error( err_syntax );
  899. #endif
  900.       return NULL;
  901.       }
  902.    else if ( argc > 1 )
  903.       {
  904. #if PROG_ERRORS
  905.       sprintf( bwb_ebuf, "Too many parameters (%d) to function LOF().",
  906.          argc );
  907.       bwb_error( bwb_ebuf );
  908. #else
  909.       bwb_error( err_syntax );
  910. #endif
  911.       return NULL;
  912.       }
  913.  
  914.    dev_number = var_getival( &( argv[ 0 ] ) );
  915.  
  916.    if ( init == FALSE )
  917.       {
  918.       init = TRUE;
  919.       var_make( &nvar, SINGLE );
  920.       }
  921.  
  922.    /* stat the file */
  923.  
  924.    r = stat( dev_table[ dev_number ].filename, &statbuf );
  925.  
  926.    if ( r != 0 )
  927.       {
  928. #if PROG_ERRORS
  929.       sprintf( bwb_ebuf, "in fnc_lof(): failed to find file <%s>",
  930.          dev_table[ dev_number ].filename );
  931.       bwb_error( bwb_ebuf );
  932. #else
  933.       sprintf( bwb_ebuf, ERR_OPENFILE,
  934.          dev_table[ dev_number ].filename );
  935.       bwb_error( bwb_ebuf );
  936. #endif
  937.       return NULL;
  938.       }
  939.  
  940.    * var_findfval( &nvar, nvar.array_pos ) = (float) statbuf.st_size;
  941.  
  942.    return &nvar;
  943.    }
  944.  
  945. /***************************************************************
  946.  
  947.         FUNCTION:       bwb_kill()
  948.  
  949.         DESCRIPTION: This function implements the BASIC KILL
  950.         command to erase a disk file.
  951.  
  952.         SYNTAX: KILL btbuf$
  953.  
  954. ***************************************************************/
  955.  
  956. struct bwb_line *
  957. bwb_kill( struct bwb_line *l )
  958.    {
  959.    int r;
  960.    static int position;
  961.    struct exp_ese *e;
  962.    static char *atbuf;
  963.    static int init = FALSE;
  964.  
  965.    /* get memory for temporary buffers if necessary */
  966.  
  967.    if ( init == FALSE )
  968.       {
  969.       init = TRUE;
  970.       if ( ( atbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL )
  971.          {
  972.          bwb_error( err_getmem );
  973.          }
  974.       }
  975.  
  976.    /* get the next element in atbuf */
  977.  
  978.    adv_element( l->buffer, &( l->position ), atbuf  );
  979.  
  980. #if INTENSIVE_DEBUG
  981.    sprintf( bwb_ebuf, "in bwb_kill(): argument is <%s>", atbuf );
  982.    bwb_debug( bwb_ebuf );
  983. #endif
  984.  
  985.    /* interpret the argument */
  986.  
  987.    position = 0;
  988.   e = bwb_exp( atbuf, FALSE, &position );
  989.  
  990.    if ( e->type != STRING )
  991.       {
  992.       bwb_error( err_argstr );
  993.       l->next->position = 0;
  994.       return l->next;
  995.       }
  996.  
  997.    /* try to delete the specified file */
  998.  
  999.    str_btoc( atbuf, &( e->sval ) );
  1000.    r = unlink( atbuf );
  1001.  
  1002.    /* detect error */
  1003.  
  1004.    if ( r == -1 )
  1005.       {
  1006.       bwb_error( err_opsys );
  1007.       }
  1008.  
  1009.    l->next->position = 0;
  1010.    return l->next;
  1011.  
  1012.    }
  1013.  
  1014. #endif                /* UNIX_CMDS */
  1015.  
  1016. /***************************************************************
  1017.  
  1018.         FUNCTION:       bwb_name()
  1019.  
  1020.         DESCRIPTION: This function implements the BASIC NAME
  1021.         command to rename a disk file.
  1022.  
  1023.         SYNTAX: NAME old_btbuf$ AS new_btbuf$
  1024.  
  1025. ***************************************************************/
  1026.  
  1027. struct bwb_line *
  1028. bwb_name( struct bwb_line *l )
  1029.    {
  1030.    int r;
  1031.    static int position;
  1032.    struct exp_ese *e;
  1033.    static char *atbuf;
  1034.    static char *btbuf;
  1035.    static int init = FALSE;
  1036.  
  1037.    /* get memory for temporary buffers if necessary */
  1038.  
  1039.    if ( init == FALSE )
  1040.       {
  1041.       init = TRUE;
  1042.       if ( ( atbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL )
  1043.          {
  1044.          bwb_error( err_getmem );
  1045.          }
  1046.       if ( ( btbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL )
  1047.          {
  1048.          bwb_error( err_getmem );
  1049.          }
  1050.       }
  1051.  
  1052.    /* get the first argument in atbuf */
  1053.  
  1054.    adv_element( l->buffer, &( l->position ), atbuf  );
  1055.  
  1056.    /* interpret the first argument */
  1057.  
  1058.    position = 0;
  1059.    e = bwb_exp( atbuf, FALSE, &position );
  1060.  
  1061.    if ( e->type != STRING )
  1062.       {
  1063.       bwb_error( err_argstr );
  1064.       l->next->position = 0;
  1065.       return l->next;
  1066.       }
  1067.  
  1068.    /* this argument must be copied back to atbuf, else the next
  1069.       call to bwb_exp() will overwrite the structure to which e
  1070.       refers */
  1071.  
  1072.    str_btoc( atbuf, &( e->sval ) );
  1073.  
  1074. #if INTENSIVE_DEBUG
  1075.    sprintf( bwb_ebuf, "in bwb_name(): old name is <%s>", atbuf );
  1076.    bwb_debug( bwb_ebuf );
  1077. #endif
  1078.  
  1079.    /* get the second argument in btbuf */
  1080.  
  1081.    adv_element( l->buffer, &( l->position ), btbuf  );
  1082.    bwb_strtoupper( btbuf );
  1083.  
  1084. #if INTENSIVE_DEBUG
  1085.    sprintf( bwb_ebuf, "in bwb_name(): AS string is <%s>", btbuf );
  1086.    bwb_debug( bwb_ebuf );
  1087. #endif
  1088.  
  1089.    if ( strcmp( btbuf, "AS" ) != 0 )
  1090.       {
  1091.       bwb_error( err_syntax );
  1092.       l->next->position = 0;
  1093.       return l->next;
  1094.       }
  1095.  
  1096.    /* get the third argument in btbuf */
  1097.  
  1098.    adv_element( l->buffer, &( l->position ), btbuf  );
  1099.  
  1100.    /* interpret the third argument */
  1101.  
  1102.    position = 0;
  1103.    e = bwb_exp( btbuf, FALSE, &position );
  1104.  
  1105.    if ( e->type != STRING )
  1106.       {
  1107.       bwb_error( err_argstr );
  1108.       l->next->position = 0;
  1109.       return l->next;
  1110.       }
  1111.  
  1112.    str_btoc( btbuf, &( e->sval ) );
  1113.  
  1114. #if INTENSIVE_DEBUG
  1115.    sprintf( bwb_ebuf, "in bwb_name(): new name is <%s>", btbuf );
  1116.    bwb_debug( bwb_ebuf );
  1117. #endif
  1118.  
  1119.    /* try to rename the file */
  1120.  
  1121.    r = rename( atbuf, btbuf );
  1122.  
  1123.    /* detect error */
  1124.  
  1125.    if ( r != 0 )
  1126.       {
  1127.       bwb_error( err_opsys );
  1128.       }
  1129.  
  1130.    l->next->position = 0;
  1131.    return l->next;
  1132.  
  1133.    }
  1134.  
  1135. /***************************************************************
  1136.  
  1137.         FUNCTION:       bwb_field()
  1138.  
  1139.         DESCRIPTION:    This C function implements the BASIC
  1140.             FIELD command.
  1141.  
  1142. ***************************************************************/
  1143.  
  1144. struct bwb_line *
  1145. bwb_field( struct bwb_line *l )
  1146.    {
  1147.    int dev_number;
  1148.    int length;
  1149.    struct exp_ese *e;
  1150.    struct bwb_variable *v;
  1151.    bstring *b;
  1152.    int current_pos;
  1153.    char atbuf[ MAXSTRINGSIZE + 1 ];
  1154.    char btbuf[ MAXSTRINGSIZE + 1 ];
  1155.  
  1156.    current_pos = 0;
  1157.  
  1158.    /* first read device number */
  1159.  
  1160.    adv_ws( l->buffer, &( l->position ) );
  1161.    if ( l->buffer[ l->position ] =='#' )
  1162.       {
  1163.       ++( l->position );
  1164.       }
  1165.  
  1166.    adv_element( l->buffer, &( l->position ), atbuf );
  1167.  
  1168. #if INTENSIVE_DEBUG
  1169.    sprintf( bwb_ebuf, "in bwb_field(): device # buffer <%s>", atbuf );
  1170.    bwb_debug( bwb_ebuf );
  1171. #endif
  1172.  
  1173.    pos = 0;
  1174.    e = bwb_exp( atbuf, FALSE, &pos );
  1175.  
  1176.    if ( e->type != INTEGER )
  1177.       {
  1178. #if PROG_ERRORS
  1179.       bwb_error( "in bwb_field(): Integer was expected for device number" );
  1180. #else
  1181.       bwb_error( err_syntax );
  1182. #endif
  1183.       return l;
  1184.       }
  1185.  
  1186.    dev_number = exp_getival( e );
  1187.  
  1188. #if INTENSIVE_DEBUG
  1189.    sprintf( bwb_ebuf, "in bwb_field(): device <%d>", dev_number );
  1190.    bwb_debug( bwb_ebuf );
  1191. #endif
  1192.  
  1193.    /* be sure that the requested device is open */
  1194.  
  1195.    if (( dev_table[ dev_number ].mode == DEVMODE_CLOSED ) ||
  1196.       ( dev_table[ req_devnumber ].mode == DEVMODE_AVAILABLE ) )
  1197.       {
  1198. #if PROG_ERRORS
  1199.       bwb_error( "in bwb_field(): Requested device number is not in use." );
  1200. #else
  1201.       bwb_error( err_devnum );
  1202. #endif
  1203.       return l;
  1204.       }
  1205.  
  1206.    /* loop to read variables */
  1207.  
  1208.    do
  1209.       {
  1210.  
  1211.       /* read the comma and advance beyond it */
  1212.  
  1213.       adv_ws( l->buffer, &( l->position ) );
  1214.       if ( l->buffer[ l->position ] ==',' )
  1215.          {
  1216.          ++( l->position );
  1217.          }
  1218.  
  1219.       /* first find the size of the field */
  1220.  
  1221.       adv_element( l->buffer, &( l->position ), atbuf );    /* get element */
  1222.  
  1223.       pos = 0;
  1224.       e = bwb_exp( atbuf, FALSE, &pos );
  1225.  
  1226.       if ( e->type != INTEGER )
  1227.          {
  1228. #if PROG_ERRORS
  1229.          bwb_error( "in bwb_field(): integer value for field size not found" );
  1230. #else
  1231.          bwb_error( err_syntax );
  1232. #endif
  1233.          return l;
  1234.          }
  1235.  
  1236.       length = exp_getival( e );
  1237.  
  1238. #if INTENSIVE_DEBUG
  1239.       sprintf( bwb_ebuf, "in bwb_field(): device <%d> length <%d> buf <%s>",
  1240.          dev_number, length, &( l->buffer[ l->position ] ) );
  1241.       bwb_debug( bwb_ebuf );
  1242. #endif
  1243.  
  1244.       /* read the AS */
  1245.  
  1246.       adv_element( l->buffer, &( l->position ), atbuf );    /* get element */
  1247.       bwb_strtoupper( atbuf );
  1248.  
  1249. #if INTENSIVE_DEBUG
  1250.       sprintf( bwb_ebuf, "in bwb_field(): AS element <%s>", atbuf );
  1251.       bwb_debug( bwb_ebuf );
  1252. #endif
  1253.  
  1254.       if ( strncmp( atbuf, "AS", 2 ) != 0 )
  1255.          {
  1256. #if PROG_ERRORS
  1257.          bwb_error( "in bwb_field(): AS statement not found" );
  1258. #else
  1259.          bwb_error( err_syntax );
  1260. #endif
  1261.          return l;
  1262.          }
  1263.  
  1264.       /* read the string variable name */
  1265.  
  1266.       adv_element( l->buffer, &( l->position ), atbuf );    /* get element */
  1267.       v = var_find( atbuf );
  1268.  
  1269.       if ( v->type != STRING )
  1270.          {
  1271. #if PROG_ERRORS
  1272.          bwb_error( "in bwb_field(): string variable name not found" );
  1273. #else
  1274.          bwb_error( err_syntax );
  1275. #endif
  1276.          return l;
  1277.          }
  1278.  
  1279. #if INTENSIVE_DEBUG
  1280.       sprintf( bwb_ebuf, "in bwb_field(): device <%d> var <%s> length <%d>",
  1281.          dev_number, v->name, length );
  1282.       bwb_debug( bwb_ebuf );
  1283. #endif
  1284.  
  1285.       /* check for overflow of record length */
  1286.  
  1287.       if ( ( current_pos + length ) > dev_table[ dev_number ].reclen )
  1288.          {
  1289. #if PROG_ERRORS
  1290.          bwb_error( "in bwb_field(): record length exceeded" );
  1291. #else
  1292.          bwb_error( err_overflow );
  1293. #endif
  1294.          return l;
  1295.          }
  1296.  
  1297.       /* set buffer */
  1298.  
  1299.       b = var_findsval( v, v->array_pos );
  1300.       if ( b->buffer != NULL )
  1301.          {
  1302.          free( b->buffer );
  1303.          }
  1304.       b->buffer = dev_table[ dev_number ].buffer + current_pos;
  1305.       b->length = (unsigned char) length;
  1306.       b->rab = TRUE;
  1307.  
  1308.       current_pos += length;
  1309.  
  1310. #if INTENSIVE_DEBUG
  1311.       sprintf( bwb_ebuf, "in bwb_field(): buffer <%lXh> var <%s> buffer <%lXh>",
  1312.          (long) dev_table[ dev_number ].buffer, v->name, (long) b->buffer );
  1313.       bwb_debug( bwb_ebuf );
  1314. #endif
  1315.  
  1316.       /* eat up any remaining whitespace */
  1317.  
  1318.       adv_ws( l->buffer, &( l->position ) );
  1319.  
  1320.       }
  1321.  
  1322.    while ( l->buffer[ l->position ] == ',' );
  1323.  
  1324.    /* return */
  1325.  
  1326.    return l;
  1327.  
  1328.    }
  1329.  
  1330. /***************************************************************
  1331.  
  1332.         FUNCTION:       bwb_lset()
  1333.  
  1334.         DESCRIPTION:    This C function implements the BASIC
  1335.             LSET command.
  1336.  
  1337. ***************************************************************/
  1338.  
  1339. struct bwb_line *
  1340. bwb_lset( struct bwb_line *l )
  1341.    {
  1342.    return dio_lrset( l, FALSE );
  1343.    }
  1344.    
  1345. /***************************************************************
  1346.  
  1347.         FUNCTION:       bwb_rset()
  1348.  
  1349.         DESCRIPTION:    This C function implements the BASIC
  1350.             RSET command.
  1351.  
  1352. ***************************************************************/
  1353.  
  1354. struct bwb_line *
  1355. bwb_rset( struct bwb_line *l )
  1356.    {
  1357.    return dio_lrset( l, TRUE );
  1358.    }
  1359.  
  1360. /***************************************************************
  1361.  
  1362.         FUNCTION:       dio_lrset()
  1363.  
  1364.         DESCRIPTION:    This C function implements the BASIC
  1365.             RSET and LSET commands.
  1366.  
  1367. ***************************************************************/
  1368.  
  1369. static struct bwb_line *
  1370. dio_lrset( struct bwb_line *l, int rset )
  1371.    {
  1372.    char varname[ MAXVARNAMESIZE + 1 ];
  1373.    bstring *d, *s;
  1374.    int *pp;
  1375.    int n_params;
  1376.    int p;
  1377.    register int n, i;
  1378.    int startpos;
  1379.    struct exp_ese *e;
  1380.  
  1381.    /* find the variable name */
  1382.  
  1383.    bwb_getvarname( l->buffer, varname, &( l->position ));
  1384.  
  1385.    v = var_find( varname );
  1386.  
  1387.    if ( v == NULL )
  1388.       {
  1389. #if PROG_ERRORS
  1390.       sprintf( bwb_ebuf, "in dio_lrset(): failed to find variable" );
  1391.       bwb_error( bwb_ebuf );
  1392. #else
  1393.       bwb_error( err_syntax );
  1394. #endif
  1395.       }
  1396.  
  1397.    if ( v->type != STRING )
  1398.       {
  1399. #if PROG_ERRORS
  1400.       sprintf( bwb_ebuf, "in dio_lrset(): assignment must be to string variable" );
  1401.       bwb_error( bwb_ebuf );
  1402. #else
  1403.       bwb_error( err_syntax );
  1404. #endif
  1405.       }
  1406.  
  1407.    /* read subscripts */
  1408.  
  1409.    pos = 0;
  1410.    if ( ( v->dimensions == 1 ) && ( v->array_sizes[ 0 ] == 1 ))
  1411.       {
  1412. #if INTENSIVE_DEBUG
  1413.       sprintf( bwb_ebuf, "in dio_lrset(): variable <%s> has 1 dimension",
  1414.          v->name );
  1415.       bwb_debug( bwb_ebuf );
  1416. #endif
  1417.       n_params = 1;
  1418.       pp = &p;
  1419.       pp[ 0 ] = dim_base;
  1420.       }
  1421.    else
  1422.       {
  1423. #if INTENSIVE_DEBUG
  1424.       sprintf( bwb_ebuf, "in dio_lrset(): variable <%s> has > 1 dimensions",
  1425.          v->name );
  1426.       bwb_debug( bwb_ebuf );
  1427. #endif
  1428.       dim_getparams( l->buffer, &( l->position ), &n_params, &pp );
  1429.       }
  1430.  
  1431.    exp_es[ exp_esc ].pos_adv = pos;
  1432.    for ( n = 0; n < v->dimensions; ++n )
  1433.       {
  1434.       v->array_pos[ n ] = pp[ n ];
  1435.       }
  1436.  
  1437.    /* get bstring pointer */
  1438.  
  1439.    d = var_findsval( v, pp );
  1440.  
  1441.    /* find equals sign */
  1442.  
  1443.    adv_ws( l->buffer, &( l->position ));
  1444.    if ( l->buffer[ l->position ] != '=' )
  1445.       {
  1446. #if PROG_ERRORS
  1447.       sprintf( bwb_ebuf, "in dio_lrset(): failed to find equal sign" );
  1448.       bwb_error( bwb_ebuf );
  1449. #else
  1450.       bwb_error( err_syntax );
  1451. #endif
  1452.       }
  1453.    ++( l->position );
  1454.    adv_ws( l->buffer, &( l->position ));
  1455.  
  1456.    /* read remainder of line to get value */
  1457.  
  1458.    e = bwb_exp( l->buffer, FALSE, &( l->position ) );
  1459.    s = exp_getsval( e );
  1460.  
  1461.    /* set starting position */
  1462.  
  1463.    startpos = 0;
  1464.    if ( rset == TRUE )
  1465.       {
  1466.       if ( s->length < d->length )
  1467.          {
  1468.          startpos = d->length - s->length;
  1469.          }
  1470.       }
  1471.  
  1472. #if INTENSIVE_DEBUG
  1473.    sprintf( bwb_ebuf, "in dio_lrset(): startpos <%d> buffer <%lX>", 
  1474.       startpos, (long) d->buffer );
  1475.    bwb_debug( bwb_ebuf );
  1476. #endif
  1477.  
  1478.    /* write characters to new position */
  1479.  
  1480.    i = 0;
  1481.    for ( n = startpos; ( i < s->length ) && ( n < d->length ); ++n )
  1482.       {
  1483.       d->buffer[ n ] = s->buffer[ i ];
  1484.       ++i;
  1485.       }
  1486.  
  1487.    /* return */
  1488.  
  1489.    return l;
  1490.  
  1491.    }
  1492.  
  1493. /***************************************************************
  1494.  
  1495.         FUNCTION:       bwb_get()
  1496.  
  1497.         DESCRIPTION:    This C function implements the BASIC
  1498.             GET command.
  1499.  
  1500. ***************************************************************/
  1501.  
  1502. struct bwb_line *
  1503. bwb_get( struct bwb_line *l )
  1504.    {
  1505.    int dev_number;
  1506.    int rec_number;
  1507.    register int i;
  1508.    struct exp_ese *e;
  1509.    char atbuf[ MAXSTRINGSIZE + 1 ];
  1510.    char btbuf[ MAXSTRINGSIZE + 1 ];
  1511.  
  1512.    /* first read device number */
  1513.  
  1514.    adv_ws( l->buffer, &( l->position ) );
  1515.    if ( l->buffer[ l->position ] =='#' )
  1516.       {
  1517.       ++( l->position );
  1518.       }
  1519.  
  1520.    adv_element( l->buffer, &( l->position ), atbuf );
  1521.  
  1522.    pos = 0;
  1523.    e = bwb_exp( atbuf, FALSE, &pos );
  1524.  
  1525.    if ( e->type != INTEGER )
  1526.       {
  1527. #if PROG_ERRORS
  1528.       bwb_error( "in bwb_get(): Integer was expected for device number" );
  1529. #else
  1530.       bwb_error( err_syntax );
  1531. #endif
  1532.       return l;
  1533.       }
  1534.  
  1535.    dev_number = exp_getival( e );
  1536.  
  1537. #if INTENSIVE_DEBUG
  1538.    sprintf( bwb_ebuf, "in bwb_get(): device <%d>", dev_number );
  1539.    bwb_debug( bwb_ebuf );
  1540. #endif
  1541.  
  1542.    /* be sure that the requested device is open */
  1543.  
  1544.    if ( ( dev_table[ dev_number ].mode == DEVMODE_CLOSED ) ||
  1545.       ( dev_table[ req_devnumber ].mode == DEVMODE_AVAILABLE ) )
  1546.       {
  1547. #if PROG_ERRORS
  1548.       bwb_error( "in bwb_get(): Requested device number is not in use." );
  1549. #else
  1550.       bwb_error( err_devnum );
  1551. #endif
  1552.       return l;
  1553.       }
  1554.  
  1555.    /* see if there is a comma (and record number) */
  1556.  
  1557.    adv_ws( l->buffer, &( l->position ) );
  1558.    if ( l->buffer[ l->position ] == ',' )    /* yes, there is a comma */
  1559.       {
  1560.       ++( l->position );
  1561.  
  1562.       /* get the record number element */
  1563.  
  1564.       adv_element( l->buffer, &( l->position ), atbuf );
  1565.  
  1566.       pos = 0;
  1567.       e = bwb_exp( atbuf, FALSE, &pos );
  1568.       rec_number = exp_getival( e );
  1569.  
  1570.       }
  1571.  
  1572.    else                /* no record number given */
  1573.       {
  1574.       rec_number = dev_table[ dev_number ].next_record;
  1575.       }
  1576.  
  1577. #if INTENSIVE_DEBUG
  1578.    sprintf( bwb_ebuf, "in bwb_get(): record number <%d>", rec_number );
  1579.    bwb_debug( bwb_ebuf );
  1580. #endif
  1581.  
  1582.    /* wind the c file up to the proper point */
  1583.  
  1584.    if ( fseek( dev_table[ dev_number ].cfp,
  1585.       (long) (( rec_number - 1 ) * dev_table[ dev_number ].reclen ), 
  1586.       SEEK_SET ) != 0 )
  1587.       {
  1588. #if PROG_ERRORS
  1589.       sprintf( bwb_ebuf, "in bwb_get(): fseek() failed, rec number <%d> offset <%ld>",
  1590.         rec_number, (long) (( rec_number - 1 ) * dev_table[ dev_number ].reclen ) );
  1591.       bwb_error( bwb_ebuf );
  1592. #else
  1593.       bwb_error( err_dev );
  1594. #endif
  1595.       return l;
  1596.       }
  1597.  
  1598.    /* read the requested bytes into the buffer */
  1599.  
  1600.    for ( i = 0; i < dev_table[ dev_number ].reclen; ++i )
  1601.       {
  1602.       dev_table[ dev_number ].buffer[ i ] =
  1603.          (char) fgetc( dev_table[ dev_number ].cfp );
  1604.       ++( dev_table[ dev_number ].loc );
  1605.       }
  1606.  
  1607.    /* increment (or reset) the current record */
  1608.  
  1609.    dev_table[ dev_number ].next_record = rec_number + 1;
  1610.  
  1611.    return l;
  1612.  
  1613.    }
  1614.  
  1615. /***************************************************************
  1616.  
  1617.         FUNCTION:       bwb_put()
  1618.  
  1619.         DESCRIPTION:    This C function implements the BASIC
  1620.             PUT command.
  1621.  
  1622. ***************************************************************/
  1623.  
  1624. struct bwb_line *
  1625. bwb_put( struct bwb_line *l )
  1626.    {
  1627.    int dev_number;
  1628.    int rec_number;
  1629.    register int i;
  1630.    struct exp_ese *e;
  1631.    struct bwb_variable *v;
  1632.    char atbuf[ MAXSTRINGSIZE + 1 ];
  1633.    char btbuf[ MAXSTRINGSIZE + 1 ];
  1634.  
  1635.    /* first read device number */
  1636.  
  1637.    adv_ws( l->buffer, &( l->position ) );
  1638.    if ( l->buffer[ l->position ] =='#' )
  1639.       {
  1640.       ++( l->position );
  1641.       }
  1642.  
  1643.    adv_element( l->buffer, &( l->position ), atbuf );
  1644.    dev_number = atoi( atbuf );
  1645.  
  1646. #if INTENSIVE_DEBUG
  1647.    sprintf( bwb_ebuf, "in bwb_put(): device <%d>", dev_number );
  1648.    bwb_debug( bwb_ebuf );
  1649. #endif
  1650.  
  1651.    /* be sure that the requested device is open */
  1652.  
  1653.    if ( ( dev_table[ dev_number ].mode == DEVMODE_CLOSED ) ||
  1654.       ( dev_table[ req_devnumber ].mode == DEVMODE_AVAILABLE ) )
  1655.       {
  1656. #if PROG_ERRORS
  1657.       bwb_error( "in bwb_put(): Requested device number is not in use." );
  1658. #else
  1659.       bwb_error( err_devnum );
  1660. #endif
  1661.       return l;
  1662.       }
  1663.  
  1664.    /* see if there is a comma (and record number) */
  1665.  
  1666.    adv_ws( l->buffer, &( l->position ) );
  1667.    if ( l->buffer[ l->position ] == ',' )    /* yes, there is a comma */
  1668.       {
  1669.       ++( l->position );
  1670.  
  1671.       /* get the record number element */
  1672.  
  1673.       adv_element( l->buffer, &( l->position ), atbuf );
  1674.  
  1675. #if INTENSIVE_DEBUG
  1676.       sprintf( bwb_ebuf, "in bwb_put(): rec no buffer <%s>", atbuf );
  1677.       bwb_debug( bwb_ebuf );
  1678. #endif
  1679.  
  1680.       pos = 0;
  1681.       e = bwb_exp( atbuf, FALSE, &pos );
  1682.  
  1683. #if INTENSIVE_DEBUG
  1684.       sprintf( bwb_ebuf, "in bwb_put(): return type <%c>", e->type );
  1685.       bwb_debug( bwb_ebuf );
  1686. #endif
  1687.  
  1688.       rec_number = exp_getival( e );
  1689.  
  1690.       }
  1691.  
  1692.    else                /* no record number given */
  1693.       {
  1694.       rec_number = dev_table[ dev_number ].next_record;
  1695.       }
  1696.  
  1697. #if INTENSIVE_DEBUG
  1698.    sprintf( bwb_ebuf, "in bwb_put(): record number <%d>", rec_number );
  1699.    bwb_debug( bwb_ebuf );
  1700. #endif
  1701.  
  1702.    /* wind the c file up to the proper point */
  1703.  
  1704.    if ( fseek( dev_table[ dev_number ].cfp,
  1705.       (long) (( rec_number - 1 ) * dev_table[ dev_number ].reclen ), 
  1706.       SEEK_SET ) != 0 )
  1707.       {
  1708. #if PROG_ERRORS
  1709.       sprintf( bwb_ebuf, "in bwb_get(): fseek() failed, rec number <%d> offset <%ld>",
  1710.         rec_number, (long) (( rec_number - 1 ) * dev_table[ dev_number ].reclen ) );
  1711.       bwb_error( bwb_ebuf );
  1712. #else
  1713.       bwb_error( err_dev );
  1714. #endif
  1715.       return l;
  1716.       }
  1717.  
  1718. #if INTENSIVE_DEBUG
  1719.    sprintf( bwb_ebuf, "in bwb_put(): ready to write to file, buffer <%lXh>",
  1720.       (long) dev_table[ dev_number ].buffer );
  1721.    bwb_debug( bwb_ebuf );
  1722.    xprintf( stderr, "Buffer: <" );
  1723. #endif
  1724.  
  1725.    /* write the requested bytes to the file */
  1726.  
  1727.    for ( i = 0; i < dev_table[ dev_number ].reclen; ++i )
  1728.       {
  1729.       fputc( dev_table[ dev_number ].buffer[ i ],
  1730.          dev_table[ dev_number ].cfp );
  1731. #if INTENSIVE_DEBUG
  1732.       xputc( stderr, dev_table[ dev_number ].buffer[ i ] );
  1733. #endif
  1734.       ++( dev_table[ dev_number ].loc );
  1735.       }
  1736.  
  1737. #if INTENSIVE_DEBUG
  1738.    xprintf( stderr, ">\n" );
  1739.    sprintf( bwb_ebuf, "in bwb_put(): write to file complete" );
  1740.    bwb_debug( bwb_ebuf );
  1741. #endif
  1742.  
  1743.    /* flush the buffer */
  1744.  
  1745.    dio_flush( dev_number );
  1746.  
  1747.    /* increment (or reset) the current record */
  1748.  
  1749.    dev_table[ dev_number ].next_record = rec_number + 1;
  1750.  
  1751.    return l;
  1752.  
  1753.    }
  1754.  
  1755. /***************************************************************
  1756.  
  1757.         FUNCTION:       dio_flush()
  1758.  
  1759.         DESCRIPTION:    This C function flushes the random-access
  1760.             buffer associated with file dev_number.
  1761.  
  1762. ***************************************************************/
  1763.  
  1764. static int
  1765. dio_flush( int dev_number )
  1766.    {
  1767.    register int n;
  1768.  
  1769.    if ( dev_table[ dev_number ].mode != DEVMODE_RANDOM )
  1770.       {
  1771. #if PROG_ERRORS
  1772.       sprintf( bwb_ebuf, "in dio_flush(): only random-access buffers can be flushed" );
  1773.       bwb_error( bwb_ebuf );
  1774. #else
  1775.       bwb_error( err_dev );
  1776. #endif
  1777.       }
  1778.  
  1779.    /* fill buffer with blanks (or 'X' for test) */
  1780.  
  1781.    for ( n = 0; n < dev_table[ req_devnumber ].reclen; ++n )
  1782.       {
  1783.       dev_table[ req_devnumber ].buffer[ n ] = RANDOM_FILLCHAR;
  1784.       }
  1785.  
  1786.    return TRUE;
  1787.  
  1788.    }
  1789.  
  1790. /***************************************************************
  1791.  
  1792.         FUNCTION:       fnc_loc()
  1793.  
  1794.         DESCRIPTION:    This C function implements the BASIC
  1795.             LOC() function. As implemented here,
  1796.             this only workd for random-acess files.
  1797.  
  1798. ***************************************************************/
  1799.  
  1800. struct bwb_variable *
  1801. fnc_loc( int argc, struct bwb_variable *argv )
  1802.    {
  1803.    static struct bwb_variable nvar;
  1804.    static int init = FALSE;
  1805.    int dev_number;
  1806.  
  1807. #if INTENSIVE_DEBUG
  1808.    sprintf( bwb_ebuf, "in fnc_loc(): received f_arg <%f> ",
  1809.       var_getdval( &( argv[ 0 ] ) ) );
  1810.    bwb_debug( bwb_ebuf );
  1811. #endif
  1812.  
  1813.    if ( argc < 1 )
  1814.       {
  1815. #if PROG_ERRORS
  1816.       sprintf( bwb_ebuf, "Not enough parameters (%d) to function LOC().",
  1817.          argc );
  1818.       bwb_error( bwb_ebuf );
  1819. #else
  1820.       bwb_error( err_syntax );
  1821. #endif
  1822.       return NULL;
  1823.       }
  1824.    else if ( argc > 1 )
  1825.       {
  1826. #if PROG_ERRORS
  1827.       sprintf( bwb_ebuf, "Too many parameters (%d) to function LOC().",
  1828.          argc );
  1829.       bwb_error( bwb_ebuf );
  1830. #else
  1831.       bwb_error( err_syntax );
  1832. #endif
  1833.       return NULL;
  1834.       }
  1835.  
  1836.    dev_number = var_getival( &( argv[ 0 ] ) );
  1837.  
  1838.    if ( init == FALSE )
  1839.       {
  1840.       init = TRUE;
  1841.       var_make( &nvar, INTEGER );
  1842.       }
  1843.  
  1844.    /* note if this is the very beginning of the file */
  1845.  
  1846.    if ( dev_table[ dev_number ].loc == 0 )
  1847.       {
  1848.       * var_findival( &nvar, nvar.array_pos ) = 0;
  1849.       }
  1850.    else
  1851.       {
  1852.       * var_findival( &nvar, nvar.array_pos ) =
  1853.          dev_table[ dev_number ].next_record;
  1854.       }
  1855.  
  1856.    return &nvar;
  1857.    }
  1858.  
  1859. /***************************************************************
  1860.  
  1861.         FUNCTION:       fnc_eof()
  1862.  
  1863.         DESCRIPTION:    This C function implements the BASIC
  1864.             EOF() function. 
  1865.  
  1866. ***************************************************************/
  1867.  
  1868. struct bwb_variable *
  1869. fnc_eof( int argc, struct bwb_variable *argv )
  1870.    {
  1871.    static struct bwb_variable nvar;
  1872.    static int init = FALSE;
  1873.    int dev_number;
  1874.  
  1875. #if INTENSIVE_DEBUG
  1876.    sprintf( bwb_ebuf, "in fnc_loc(): received f_arg <%f> ",
  1877.       var_getdval( &( argv[ 0 ] ) ) );
  1878.    bwb_debug( bwb_ebuf );
  1879. #endif
  1880.  
  1881.    if ( argc < 1 )
  1882.       {
  1883. #if PROG_ERRORS
  1884.       sprintf( bwb_ebuf, "Not enough parameters (%d) to function EOF().",
  1885.          argc );
  1886.       bwb_error( bwb_ebuf );
  1887. #else
  1888.       bwb_error( err_syntax );
  1889. #endif
  1890.       return NULL;
  1891.       }
  1892.    else if ( argc > 1 )
  1893.       {
  1894. #if PROG_ERRORS
  1895.       sprintf( bwb_ebuf, "Too many parameters (%d) to function EOF().",
  1896.          argc );
  1897.       bwb_error( bwb_ebuf );
  1898. #else
  1899.       bwb_error( err_syntax );
  1900. #endif
  1901.       return NULL;
  1902.       }
  1903.  
  1904.    dev_number = var_getival( &( argv[ 0 ] ) );
  1905.  
  1906.    if ( init == FALSE )
  1907.       {
  1908.       init = TRUE;
  1909.       var_make( &nvar, INTEGER );
  1910.       }
  1911.  
  1912.    /* note if this is the very beginning of the file */
  1913.  
  1914.    if ( dev_table[ dev_number ].mode == DEVMODE_AVAILABLE )
  1915.       {
  1916.       bwb_error( err_devnum );
  1917.       * var_findival( &nvar, nvar.array_pos ) = TRUE;
  1918.       }
  1919.    else if ( dev_table[ dev_number ].mode == DEVMODE_CLOSED )
  1920.       {
  1921.       bwb_error( err_devnum );
  1922.       * var_findival( &nvar, nvar.array_pos ) = TRUE;
  1923.       }
  1924.    else if ( feof( dev_table[ dev_number ].cfp ) == 0 )
  1925.       {
  1926.       * var_findival( &nvar, nvar.array_pos ) = FALSE;
  1927.       }
  1928.    else
  1929.       {
  1930.       * var_findival( &nvar, nvar.array_pos ) = TRUE;
  1931.       }
  1932.  
  1933.    return &nvar;
  1934.    }
  1935.  
  1936.  
  1937.